home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / hsys-hbase.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  6.4 KB  |  175 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hsys-hbase.el
  4. ;; SUMMARY:      Hyperbole support for the Hyperbase system.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     comm, hypermedia
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Brown U.
  10. ;;
  11. ;; ORIG-DATE:    16-Oct-91 at 04:35:09
  12. ;; LAST-MOD:     14-Apr-95 at 16:08:38 by Bob Weiner
  13. ;;
  14. ;; This file is part of Hyperbole.
  15. ;; Available for use and distribution under the same terms as GNU Emacs.
  16. ;;
  17. ;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
  18. ;; Developed with support from Motorola Inc.
  19. ;;
  20. ;; DESCRIPTION:  
  21. ;;
  22. ;;   In order to use this package, you must have the Hyperbase system
  23. ;;   and must start up a Hyperbase server and then load the Hyperbase
  24. ;;   Epoch support software that comes with the Hyperbase system.
  25. ;;
  26. ;;   Then load this package and Hyperbole will do the following when
  27. ;;   in a Hyperbase buffer:
  28. ;;
  29. ;;     Action Key press on a button follows the link, within any other
  30. ;;     text, closes current Epoch screen and kills node buffer.
  31. ;;
  32. ;;     Assist Key press shows attributes for the current button or
  33. ;;     for the current node buffer, if no current button.
  34. ;;
  35. ;; DESCRIP-END.
  36.  
  37. ;;; ************************************************************************
  38. ;;; Other required Elisp libraries
  39. ;;; ************************************************************************
  40.  
  41. (require 'hbut)
  42.  
  43. ;;; ************************************************************************
  44. ;;; Public variables
  45. ;;; ************************************************************************
  46.  
  47. (defib hyperbase ()
  48.   "Detects link buttons in buffers that communicate with the Hyperbase system.
  49. Hyperbase is a hypertext database system that interfaces to Emacs."
  50.   (and (boundp 'ehts-mode) ehts-mode
  51.        (let ((lbl (or (ebut:label-p 'as-label "[-> " "]")
  52.               "no-but")))
  53.      (ibut:label-set lbl)
  54.      (hact 'hyperbase lbl))))
  55.  
  56. (defact hyperbase (linkname)
  57.   "Follows LINKNAME in a buffer that communicates with the Hyperbase system.
  58. If LINKNAME equals t, closes the current Epoch screen and kill the
  59. buffer of the current Hyperbase node.
  60. Hyperbase is a hypertext database system that interfaces to Emacs."
  61.   ;; From hb-EHTS.el by:
  62.   ;;    Uffe Kock Wiil         (kock@iesd.auc.dk)
  63.   ;;    Claus Bo Nielsen     (cbn@cci.dk)
  64.   ;;
  65.   (if (equal linkname "no-but")
  66.       (progn (ehts-mouse-kill-screen-and-buffer t)
  67.          (and (fboundp 'epoch::select-screen)
  68.           (epoch::select-screen)))
  69.     (let ((linknum (cdr (assoc linkname ehts-node-link-alist))) tonode)
  70.       (ehts-command t)
  71.       (if (< (ehts-hb-sys-call "read" linknum "to data node no" nil t) 0)
  72.       (progn
  73.         (ehts-command nil)
  74.         (error "Can't read \"to data node no\" in link, panic !!!")))
  75.       (ehts-read-4bytes)
  76.       (setq tonode (ehts-read-4bytes))
  77.       (if (< (ehts-hb-sys-call "read" tonode "n name" nil t) 0)
  78.       (progn
  79.         (ehts-command nil)
  80.         (error "Can't read \"name\" in data node, panic !!!")))
  81.       (ehts-get-node (ehts-read-null-string))
  82.       (and (fboundp 'hproperty:but-create-all)
  83.        (hproperty:but-create-all "[-> " "]"))
  84.       (ehts-command nil))))
  85.  
  86. ;;; ************************************************************************
  87. ;;; Public functions
  88. ;;; ************************************************************************
  89.  
  90. (defun hyperbase:init ()
  91.   "Show initial set of Hyperbase buttons."
  92.   (if (assoc (user-full-name) ehts-node-name-alist)
  93.       (progn
  94.     (ehts-get-node (user-full-name))
  95.     (let (buffer screen)
  96.       (setq buffer "*Ehts Welcome*")
  97.       (setq screen (ehts-find-buffer-screen buffer))
  98.       (kill-buffer buffer)
  99.       (switch-to-buffer (user-full-name))
  100.       (remove-screen screen)))
  101.     (if (assoc "dir ehts help" ehts-node-name-alist)
  102.     (progn
  103.       (ehts-get-node "dir ehts help")
  104.       (let (buffer screen)
  105.         (setq buffer "*Ehts Welcome*")
  106.         (setq screen (ehts-find-buffer-screen buffer))
  107.         (kill-buffer buffer)
  108.         (switch-to-buffer "dir ehts help")
  109.         (remove-screen screen)
  110.         (hproperty:but-create "[-> " "]"))))))
  111.  
  112. (defun hyperbase:help (&optional but)
  113.   "Displays attributes of a link button BUT if on one or of the current node.
  114. Hyperbase is a hypertext database system that interfaces to Emacs."
  115.   (interactive (list (ibut:at-p)))
  116.   (or (and (boundp 'ehts-mode) ehts-mode)
  117.       (error "(hyperbase:help): Not in a Hyperbase mode buffer."))
  118.   (hyperbase:attr-help
  119.    (or (and (symbolp but) 
  120.         (let ((lbl (ebut:key-to-label (hattr:get but 'lbl-key))))
  121.           (if (not (equal lbl "no-but")) lbl)))
  122.        (current-buffer))))
  123.  
  124. ;;; ************************************************************************
  125. ;;; Private functions
  126. ;;; ************************************************************************
  127.  
  128. (defun hyperbase:already-displayed-p (name)
  129.   "Test if a buffer allready is displayed."
  130.   (let (screenid)
  131.     (setq screenid (ehts-find-buffer-screen name))
  132.     (if screenid
  133.     (progn
  134.       (switch-screen screenid)
  135.       t)
  136.       nil)))
  137.  
  138. (defun hyperbase:attr-help (node-link-spec)
  139.   "Show the attributes of a node or a button link from NODE-LINK-SPEC.
  140. A string value of NODE-LINK-SPEC means show attributes for that button link.
  141. A buffer value means show attributes for the node in that buffer."
  142.   (interactive)
  143.   (or (stringp node-link-spec) (bufferp node-link-spec)
  144.       (error "(hyperbase-show-attributes): Non-string or buffer argument."))
  145.   (let (entity name string number buffer screenid)
  146.     (setq buffer (if (bufferp node-link-spec) (buffer-name node-link-spec))
  147.       entity (cdr (assoc (if buffer "node" "link") node-link-list))
  148.       buffer (or buffer (buffer-name)))
  149.     (if (eq (string-match "Attributes - " buffer) 0)
  150.     nil
  151.       (if (= entity 0)
  152.       (progn
  153.         (setq name (concat "Attributes - " buffer))
  154.         (if (not (hyperbase:already-displayed-p name))
  155.         (progn
  156.           (setq number (cdr (assoc buffer ehts-node-name-alist))
  157.             string (ehts-create-node-attribute-string number))
  158.           (ehts-setup-attribute-screen name string entity buffer))))
  159.     (if (eq ehts-node-link-alist '())
  160.         (error "No links in this node."))
  161.     (setq name (concat "Attributes - "
  162.                (car (assoc node-link-spec ehts-node-link-alist))))
  163.     (if (not (hyperbase:already-displayed-p name))
  164.         (progn
  165.           (setq number (cdr (assoc (substring name 13)
  166.                        ehts-node-link-alist))
  167.             string (ehts-create-link-attribute-string number))
  168.           (ehts-setup-attribute-screen name string entity buffer)))))))
  169.  
  170. ;;; ************************************************************************
  171. ;;; Private variables
  172. ;;; ************************************************************************
  173.  
  174. (provide 'hsys-hbase)
  175.